library(car)# avPlots
library(carData)
library(MASS)
library(ggplot2)
library(plotly)  
library(dplyr)
library(GGally)  # ggpairs
library(leaps)
library(olsrr)

All models

Load data

bodyF <- read.csv("./bodyfatmen.csv",
               header = TRUE)
View(bodyF)
n <- nrow(bodyF)
p <- ncol(bodyF) # k+1

Create full model

bodyF.model <- lm(density ~ ., data = bodyF)
summary(bodyF.model)

Call:
lm(formula = density ~ ., data = bodyF)

Residuals:
       Min         1Q     Median         3Q        Max 
-0.0225107 -0.0071735  0.0002816  0.0064878  0.0254670 

Coefficients:
              Estimate Std. Error t value Pr(>|t|)    
(Intercept)  1.156e+00  5.061e-02  22.846  < 2e-16 ***
age         -1.320e-04  7.392e-05  -1.785  0.07550 .  
weight       2.378e-04  1.408e-04   1.689  0.09254 .  
height      -2.594e-05  4.083e-04  -0.064  0.94939    
neck         1.072e-03  5.371e-04   1.995  0.04720 *  
chest        1.169e-05  2.360e-04   0.050  0.96056    
abdomen     -2.200e-03  2.072e-04 -10.618  < 2e-16 ***
hip          5.268e-04  3.336e-04   1.579  0.11569    
thigh       -6.343e-04  3.336e-04  -1.901  0.05849 .  
knee        -3.418e-05  5.640e-04  -0.061  0.95172    
ankle       -4.449e-04  5.107e-04  -0.871  0.38459    
biceps      -4.274e-04  3.942e-04  -1.084  0.27940    
forearm     -1.040e-03  4.527e-04  -2.298  0.02245 *  
wrist        3.651e-03  1.227e-03   2.976  0.00322 ** 
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Residual standard error: 0.009781 on 234 degrees of freedom
Multiple R-squared:  0.7451,    Adjusted R-squared:  0.731 
F-statistic: 52.63 on 13 and 234 DF,  p-value: < 2.2e-16

We see that the model have a lot of confidence with abdomen and wrist but no so much with height, chest, hip, knee, ankle and biceps

Residuals analysis

# Normal probability plot of residuals
plot(bodyF.model, which=2)

Seems pretty good, so we have a relatively strong reason to beleive the normality assumtion of the residual. However we see a bit of light tails. The points 39, 203 and 220 could be outliers since they do not follow the normality hypothesis (but only 203 and 220 seem more severe).

# Residuals vs. fitted values
plot(bodyF.model, which=c(1,3))

plot(studres(bodyF.model), xlab="Fitted values", ylab="Studentized residual")

plot(rstudent(bodyF.model), xlab="Fitted values", ylab="R-Student residual")

Semms very good, we do not see any aparent shape, which corresponds to a uncorrelated fitted values with the residuals. We can see in the standarized residuals vs fitted values, that the points 39, 203, and 220 have a standarized residual higher than the variance, which could indicate us that they are outliers.

These plots also indicate us that we might not need to transform our y variable. Nevertheless we can try to find the sugested transformation by the Cox-Box method to further confrirm our hypothesis.

We observe that the power which maximixes the maximum likelihood is -4. However, we see that the CI are relatively long and that they also contain 1.

We can try using the transformation of y^-4 and see if it improves the prior plots.

bodyF.model.trans <- lm(density ~ ., data = bodyF.extra)
summary(bodyF.model.trans)

Call:
lm(formula = density ~ ., data = bodyF.extra)

Residuals:
      Min        1Q    Median        3Q       Max 
-0.073398 -0.019485 -0.001324  0.021791  0.071225 

Coefficients:
              Estimate Std. Error t value Pr(>|t|)    
(Intercept)  5.393e-01  1.534e-01   3.515 0.000529 ***
age          3.707e-04  2.241e-04   1.654 0.099508 .  
weight      -6.524e-04  4.268e-04  -1.529 0.127720    
height      -3.845e-04  1.238e-03  -0.311 0.756427    
neck        -3.170e-03  1.629e-03  -1.947 0.052776 .  
chest       -8.605e-05  7.157e-04  -0.120 0.904406    
abdomen      6.732e-03  6.281e-04  10.718  < 2e-16 ***
hip         -1.367e-03  1.012e-03  -1.351 0.178036    
thigh        1.545e-03  1.012e-03   1.527 0.128114    
knee        -1.501e-04  1.710e-03  -0.088 0.930130    
ankle        1.438e-03  1.549e-03   0.929 0.354081    
biceps       1.171e-03  1.195e-03   0.979 0.328357    
forearm      3.200e-03  1.373e-03   2.331 0.020594 *  
wrist       -1.153e-02  3.720e-03  -3.099 0.002180 ** 
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Residual standard error: 0.02966 on 234 degrees of freedom
Multiple R-squared:  0.7525,    Adjusted R-squared:  0.7388 
F-statistic: 54.74 on 13 and 234 DF,  p-value: < 2.2e-16
# Normal probability plot of residuals
plot(bodyF.model.trans, which=2)

# Residuals vs. fitted values
plot(bodyF.model.trans, which=c(1,3))

plot(studres(bodyF.model.trans), xlab="Fitted values", ylab="Studentized residual")

plot(rstudent(bodyF.model.trans), xlab="Fitted values", ylab="R-Student residual")

As we can see there is not a considerable improvement, neither in fixing the light tails. In addition to the long CI of the Box-Cox, we consider not necessary to do any transformation to the y varaiable.

### Horizontal band, so satisfactory distribution
#par(mfrow = c(3, 3))
# Residuals vs. regressor variables
plot(bodyF$age, bodyF.model$residuals)

plot(bodyF$weight, bodyF.model$residuals)

plot(bodyF$height, bodyF.model$residuals)

plot(bodyF$neck, bodyF.model$residuals)

plot(bodyF$chest, bodyF.model$residuals)

plot(bodyF$abdomen, bodyF.model$residuals)

plot(bodyF$hip, bodyF.model$residuals)

plot(bodyF$thigh, bodyF.model$residuals)

plot(bodyF$knee, bodyF.model$residuals)

plot(bodyF$ankle, bodyF.model$residuals)

plot(bodyF$biceps, bodyF.model$residuals)

plot(bodyF$forearm, bodyF.model$residuals)

plot(bodyF$wrist, bodyF.model$residuals)

We see that all the plots have a rectangular shape, indicating that the uncorrelation between the regresors and the residuals.

# Partial residual plots
avPlots(bodyF.model)

These plots, with the previous ones, shows us that it might not be necesary to transform our regressors since all the plots follow a line. Also we see that that the slope of the height, chest and knee is zero, while weight, neck, abdomen, hip, forearm (due to outliers) and wrist have greater slope. Thus, this indicates that we should priorize the variables with higher slope.

# PRESS statistics
pr <- resid(bodyF.model)/(1 - lm.influence(bodyF.model)$hat)
PRESS <- sum(pr^2) 
SSt <- sum((bodyF$density - mean(bodyF$density))^2)
R2prediction <- 1 - PRESS/SSt
print(R2prediction)
[1] 0.7052601

We could expect this model to explain about 70.52% of the variability in predicting new observations. Which is not as desirable, but it is not that much of a trade off compared to the R2 0.7451.

Leverage and outliers

# Define cutoff
leverage.cutoff <- 2 * p / n  # MPV p. 213
cooks.cutoff <- qf(0.5, p, n - p, lower.tail = FALSE)  # MPV p. 215
dfbetas.cutoff <- 2 / sqrt(n)  # MPV p. 218
dffits.cutoff <- 2 * sqrt(p / n)  # MPV p. 219
studres.cutoff <- qt(0.05 / 2, n - p, lower.tail = FALSE)  # MPV p. 135
### leverage points
bodyF.hat <- hatvalues(bodyF.model)
a <-bodyF.hat[bodyF.hat > leverage.cutoff]
print(a)
        5        31        36        39        41        52        83       102       155       171       202       212 
0.1221526 0.3266160 0.2006317 0.4580794 0.2170594 0.1694985 0.3631388 0.1817106 0.1879068 0.2729657 0.1836120 0.1312186 
View(bodyF[names(a),])
plot(bodyF.model, which=5)

We can see that none of the points are considered as influentials based on the Cooks distance cutoff. However, we have the points 39 and 83 which are high leverage points and are the closest to being influential. Analizing the data we observe that the point 39 corresponts to the heaviest individual (having a 100 pound gap), so that translates to having high leverage. Moreover, as we saw in the stundentized vs fitted plot it had one of the highest residual (no so good of a fit), so that made high more influential than the rest.

plot(bodyF.model, which=4)

This plot confirms our findings of not having a influential point based on Cooks distance, however we see that the point 39 has a much high value compared to the rest.

# DFFITS
bodyF.model.extra <- data.frame(fitted.values= bodyF.model$fitted.values, dffits= dffits(bodyF.model))
bodyF.model.extra[abs(bodyF.model.extra[,"dffits"]) > dffits.cutoff,] 
pp <- ggplot(bodyF.model.extra, aes(x=fitted.values, y=dffits)) + 
  geom_point() +  geom_line(data=bodyF.model.extra, aes(x=fitted.values, y=dffits.cutoff), col="red", linetype = "dashed") +geom_line(data=bodyF.model.extra, aes(x=fitted.values, y=-dffits.cutoff), col="red", linetype = "dashed")
ggplotly(pp, tooltip="text")

When we analyze the dffits we observe that there are multiple pointsthat pass our threshold, which could imply that we should change the standard threshold to a more convenient one for our porpuse. Nevertheless, the only points that are considerably over the threshold are 39 and 83, which we already observed their influence by the Cooks distance.

Now that we know the influence in the fit of the points 39 and 83 we need to analyse the points and consider if they are trully an outlier or we can compare the models generated without them and consider mantaining them.

bodyF.model.out1 <- lm(density ~ ., data = bodyF[-39,])
bodyF.model.out2 <- lm(density ~ ., data = bodyF[-83,])
bodyF.model.out3 <- lm(density ~ ., data = bodyF[c(-39 -83),])
print("All points")
[1] "All points"
summary(bodyF.model)["adj.r.squared"]
$adj.r.squared
[1] 0.7309834
print("Without 39")
[1] "Without 39"
summary(bodyF.model.out1)["adj.r.squared"]
$adj.r.squared
[1] 0.7348898
print("Without 83")
[1] "Without 83"
summary(bodyF.model.out2)["adj.r.squared"]
$adj.r.squared
[1] 0.7332889
print("Without 39 and 83")
[1] "Without 39 and 83"
summary(bodyF.model.out3)["adj.r.squared"]
$adj.r.squared
[1] 0.7315509

We see that there is no much diference in the adjusted R2 when we remove the influential points. Therefore, we conclude that we are going to maintain. In addition, we want to mention that their values seem like possible body proportions, so we might have some added interest in mantaining them.

Multicolliniarity

Since most of our regressors correnspond to dimension of the body, then we already expect to have some correlation between them. Also we expect that the weight will be correlated to some regressors as well.

# Correlation matrix 
ggpairs(data = bodyF[,-1])

We can see that the most uncorrelated variable is the age, and then the height. However we have high correlations between the rest body dimensions as we expected.

# Variance inflation factor (VIF)
# Cutoff is 10
vif(bodyF.model) 
      age    weight    height      neck     chest   abdomen       hip     thigh      knee     ankle    biceps   forearm     wrist 
 2.256000 43.944746  2.865731  4.391047 10.165371 12.881638 14.546865  7.815291  4.744625  1.952864  3.683412  2.172323  3.354584 

We see that weight, chest (merely), abdomen and hip surpass the cutoff of 10 in the VIF, which indicate us that these variables have a great dependance with the rest. We will iterativelly remove this variables and recalculate the VIFs untill there is no more variables with value greater than 10.

bodyF.noWeight <- bodyF[,-3]
bodyF.model.red1 <- lm(density ~ ., data = bodyF.noWeight)
vif(bodyF.model.red1) 
      age    height      neck     chest   abdomen       hip     thigh      knee     ankle    biceps   forearm     wrist 
 2.186067  1.727386  3.896814  7.886385 11.616571 10.767727  7.674578  4.691659  1.869511  3.515374  2.172265  3.299420 

We observe that we have reduced considerably the multicolliniarity. Now we are going to remove abdomen.

bodyF.noWeight_noAbs <- bodyF[,c(-3, -7)]
bodyF.model.red1 <- lm(density ~ ., data = bodyF.noWeight_noAbs)
vif(bodyF.model.red1) 
     age   height     neck    chest      hip    thigh     knee    ankle   biceps  forearm    wrist 
1.827180 1.700645 3.867916 5.014769 8.523918 7.547401 4.685981 1.860100 3.480125 2.167945 3.269275 

We still have some multicolliniarity such as chest, hip and thight, but not as severe as before. Therefore we can procede to variable selection with this reduced data.

Varaiable selection

All regresors

bodyF.model.red2 <- regsubsets(density~., data = bodyF.noWeight_noAbs, nvmax = 11)
a<-summary(bodyF.model.red2)
summary(bodyF.model.red2)
Subset selection object
Call: regsubsets.formula(density ~ ., data = bodyF.noWeight_noAbs, 
    nvmax = 11)
11 Variables  (and intercept)
        Forced in Forced out
age         FALSE      FALSE
height      FALSE      FALSE
neck        FALSE      FALSE
chest       FALSE      FALSE
hip         FALSE      FALSE
thigh       FALSE      FALSE
knee        FALSE      FALSE
ankle       FALSE      FALSE
biceps      FALSE      FALSE
forearm     FALSE      FALSE
wrist       FALSE      FALSE
1 subsets of each size up to 11
Selection Algorithm: exhaustive
          age height neck chest hip thigh knee ankle biceps forearm wrist
1  ( 1 )  " " " "    " "  "*"   " " " "   " "  " "   " "    " "     " "  
2  ( 1 )  " " "*"    " "  "*"   " " " "   " "  " "   " "    " "     " "  
3  ( 1 )  "*" " "    " "  "*"   " " "*"   " "  " "   " "    " "     " "  
4  ( 1 )  "*" " "    " "  "*"   " " "*"   " "  " "   " "    " "     "*"  
5  ( 1 )  "*" "*"    " "  "*"   " " "*"   " "  " "   " "    " "     "*"  
6  ( 1 )  "*" "*"    " "  "*"   "*" "*"   " "  " "   " "    " "     "*"  
7  ( 1 )  "*" "*"    "*"  "*"   "*" "*"   " "  " "   " "    " "     "*"  
8  ( 1 )  "*" "*"    "*"  "*"   "*" "*"   " "  " "   " "    "*"     "*"  
9  ( 1 )  "*" "*"    "*"  "*"   "*" "*"   " "  " "   "*"    "*"     "*"  
10  ( 1 ) "*" "*"    "*"  "*"   "*" "*"   "*"  " "   "*"    "*"     "*"  
11  ( 1 ) "*" "*"    "*"  "*"   "*" "*"   "*"  "*"   "*"    "*"     "*"  
print("Best Adjusted R2")
[1] "Best Adjusted R2"
which.max(summary(bodyF.model.red2)$adjr2)
[1] 8
print("Best Cp")
[1] "Best Cp"
which.min(summary(bodyF.model.red2)$cp)
[1] 8
print("Best BIC")
[1] "Best BIC"
which.min(summary(bodyF.model.red2)$bic)
[1] 4
all_possible_res <- ols_step_all_possible(bodyF.model.red1, metric = c("rsquare", "adjr", "cp", "aic", "sbic", "msep"))
all_possible_res
plot(all_possible_res)
It is deprecated to specify `guide = FALSE` to remove a guide. Please use `guide = "none"` instead.It is deprecated to specify `guide = FALSE` to remove a guide. Please use `guide = "none"` instead.It is deprecated to specify `guide = FALSE` to remove a guide. Please use `guide = "none"` instead.It is deprecated to specify `guide = FALSE` to remove a guide. Please use `guide = "none"` instead.It is deprecated to specify `guide = FALSE` to remove a guide. Please use `guide = "none"` instead.It is deprecated to specify `guide = FALSE` to remove a guide. Please use `guide = "none"` instead.It is deprecated to specify `guide = FALSE` to remove a guide. Please use `guide = "none"` instead.It is deprecated to specify `guide = FALSE` to remove a guide. Please use `guide = "none"` instead.It is deprecated to specify `guide = FALSE` to remove a guide. Please use `guide = "none"` instead.It is deprecated to specify `guide = FALSE` to remove a guide. Please use `guide = "none"` instead.It is deprecated to specify `guide = FALSE` to remove a guide. Please use `guide = "none"` instead.It is deprecated to specify `guide = FALSE` to remove a guide. Please use `guide = "none"` instead.It is deprecated to specify `guide = FALSE` to remove a guide. Please use `guide = "none"` instead.It is deprecated to specify `guide = FALSE` to remove a guide. Please use `guide = "none"` instead.It is deprecated to specify `guide = FALSE` to remove a guide. Please use `guide = "none"` instead.It is deprecated to specify `guide = FALSE` to remove a guide. Please use `guide = "none"` instead.It is deprecated to specify `guide = FALSE` to remove a guide. Please use `guide = "none"` instead.It is deprecated to specify `guide = FALSE` to remove a guide. Please use `guide = "none"` instead.

Forward

Backgard

Best based on Cross validation

Bootstrap assesment of the model

LS0tDQp0aXRsZTogIlByb2plY3QgMSINCm91dHB1dDogaHRtbF9ub3RlYm9vaw0KLS0tDQoNCmBgYHtyfQ0KbGlicmFyeShjYXIpIyBhdlBsb3RzDQpsaWJyYXJ5KGNhckRhdGEpDQpsaWJyYXJ5KE1BU1MpDQpsaWJyYXJ5KGdncGxvdDIpDQpsaWJyYXJ5KHBsb3RseSkgIA0KbGlicmFyeShkcGx5cikNCmxpYnJhcnkoR0dhbGx5KSAgIyBnZ3BhaXJzDQpsaWJyYXJ5KGxlYXBzKQ0KbGlicmFyeShvbHNycikNCmBgYA0KDQoNCiMgQWxsIG1vZGVscw0KTG9hZCBkYXRhDQoNCmBgYHtyfQ0KYm9keUYgPC0gcmVhZC5jc3YoIi4vYm9keWZhdG1lbi5jc3YiLA0KICAgICAgICAgICAgICAgaGVhZGVyID0gVFJVRSkNCg0KVmlldyhib2R5RikNCm4gPC0gbnJvdyhib2R5RikNCnAgPC0gbmNvbChib2R5RikgIyBrKzENCg0KYGBgDQoNCg0KDQpDcmVhdGUgZnVsbCBtb2RlbA0KYGBge3J9DQpib2R5Ri5tb2RlbCA8LSBsbShkZW5zaXR5IH4gLiwgZGF0YSA9IGJvZHlGKQ0Kc3VtbWFyeShib2R5Ri5tb2RlbCkNCmBgYA0KV2Ugc2VlIHRoYXQgdGhlIG1vZGVsIGhhdmUgYSBsb3Qgb2YgY29uZmlkZW5jZSB3aXRoIGFiZG9tZW4gYW5kIHdyaXN0IGJ1dCBubyBzbyBtdWNoIHdpdGggaGVpZ2h0LCBjaGVzdCwgaGlwLCBrbmVlLCBhbmtsZSBhbmQgYmljZXBzDQoNCiMjIFJlc2lkdWFscyBhbmFseXNpcw0KDQpgYGB7cn0NCiMgTm9ybWFsIHByb2JhYmlsaXR5IHBsb3Qgb2YgcmVzaWR1YWxzDQpwbG90KGJvZHlGLm1vZGVsLCB3aGljaD0yKQ0KYGBgDQpTZWVtcyBwcmV0dHkgZ29vZCwgc28gd2UgaGF2ZSBhIHJlbGF0aXZlbHkgc3Ryb25nIHJlYXNvbiB0byBiZWxlaXZlIHRoZSBub3JtYWxpdHkgYXNzdW10aW9uIG9mIHRoZSByZXNpZHVhbC4gSG93ZXZlciB3ZSBzZWUgYSBiaXQgb2YgbGlnaHQgdGFpbHMuIFRoZSBwb2ludHMgMzksIDIwMyBhbmQgMjIwIGNvdWxkIGJlIG91dGxpZXJzIHNpbmNlIHRoZXkgZG8gbm90IGZvbGxvdyB0aGUgbm9ybWFsaXR5IGh5cG90aGVzaXMgKGJ1dCBvbmx5IDIwMyBhbmQgMjIwIHNlZW0gbW9yZSBzZXZlcmUpLg0KDQoNCmBgYHtyfQ0KIyBSZXNpZHVhbHMgdnMuIGZpdHRlZCB2YWx1ZXMNCnBsb3QoYm9keUYubW9kZWwsIHdoaWNoPWMoMSwzKSkNCnBsb3Qoc3R1ZHJlcyhib2R5Ri5tb2RlbCksIHhsYWI9IkZpdHRlZCB2YWx1ZXMiLCB5bGFiPSJTdHVkZW50aXplZCByZXNpZHVhbCIpDQpwbG90KHJzdHVkZW50KGJvZHlGLm1vZGVsKSwgeGxhYj0iRml0dGVkIHZhbHVlcyIsIHlsYWI9IlItU3R1ZGVudCByZXNpZHVhbCIpDQpgYGANClNlbW1zIHZlcnkgZ29vZCwgd2UgZG8gbm90IHNlZSBhbnkgYXBhcmVudCBzaGFwZSwgd2hpY2ggY29ycmVzcG9uZHMgdG8gYSB1bmNvcnJlbGF0ZWQgZml0dGVkIHZhbHVlcyB3aXRoIHRoZSByZXNpZHVhbHMuIFdlIGNhbiBzZWUgaW4gdGhlIHN0YW5kYXJpemVkIHJlc2lkdWFscyB2cyBmaXR0ZWQgdmFsdWVzLCB0aGF0IHRoZSBwb2ludHMgMzksIDIwMywgYW5kIDIyMCBoYXZlIGEgc3RhbmRhcml6ZWQgcmVzaWR1YWwgaGlnaGVyIHRoYW4gdGhlIHZhcmlhbmNlLCB3aGljaCBjb3VsZCBpbmRpY2F0ZSB1cyB0aGF0IHRoZXkgYXJlIG91dGxpZXJzLg0KDQpUaGVzZSBwbG90cyBhbHNvIGluZGljYXRlIHVzIHRoYXQgd2UgbWlnaHQgbm90IG5lZWQgdG8gdHJhbnNmb3JtIG91ciB5IHZhcmlhYmxlLiBOZXZlcnRoZWxlc3Mgd2UgY2FuIHRyeSB0byBmaW5kIHRoZSBzdWdlc3RlZCB0cmFuc2Zvcm1hdGlvbiBieSB0aGUgQ294LUJveCBtZXRob2QgdG8gZnVydGhlciBjb25mcmlybSBvdXIgaHlwb3RoZXNpcy4NCg0KYGBge3J9DQpiYyA8LSBib3hDb3goYm9keUYubW9kZWwsIGxhbWJkYT1zZXEoLTEwLCAzKSkNCmJjJHhbd2hpY2goYmMkeT09bWF4KGJjJHkpKV0NCmBgYA0KV2Ugb2JzZXJ2ZSB0aGF0IHRoZSBwb3dlciB3aGljaCBtYXhpbWl4ZXMgdGhlIG1heGltdW0gbGlrZWxpaG9vZCBpcyAtNC4gSG93ZXZlciwgd2Ugc2VlIHRoYXQgdGhlIENJIGFyZSByZWxhdGl2ZWx5IGxvbmcgYW5kIHRoYXQgdGhleSBhbHNvIGNvbnRhaW4gMS4NCg0KV2UgY2FuIHRyeSB1c2luZyB0aGUgdHJhbnNmb3JtYXRpb24gb2YgeV4tNCBhbmQgc2VlIGlmIGl0IGltcHJvdmVzIHRoZSBwcmlvciBwbG90cy4NCmBgYHtyfQ0KYm9keUYuZXh0cmEgPC0gYm9keUYNCmJvZHlGLmV4dHJhJGRlbnNpdHkgPC0gKGJvZHlGJGRlbnNpdHkpXigtNCkNCmBgYA0KDQpgYGB7cn0NCmJvZHlGLm1vZGVsLnRyYW5zIDwtIGxtKGRlbnNpdHkgfiAuLCBkYXRhID0gYm9keUYuZXh0cmEpDQpzdW1tYXJ5KGJvZHlGLm1vZGVsLnRyYW5zKQ0KYGBgDQoNCmBgYHtyfQ0KIyBOb3JtYWwgcHJvYmFiaWxpdHkgcGxvdCBvZiByZXNpZHVhbHMNCnBsb3QoYm9keUYubW9kZWwudHJhbnMsIHdoaWNoPTIpDQojIFJlc2lkdWFscyB2cy4gZml0dGVkIHZhbHVlcw0KcGxvdChib2R5Ri5tb2RlbC50cmFucywgd2hpY2g9YygxLDMpKQ0KcGxvdChzdHVkcmVzKGJvZHlGLm1vZGVsLnRyYW5zKSwgeGxhYj0iRml0dGVkIHZhbHVlcyIsIHlsYWI9IlN0dWRlbnRpemVkIHJlc2lkdWFsIikNCnBsb3QocnN0dWRlbnQoYm9keUYubW9kZWwudHJhbnMpLCB4bGFiPSJGaXR0ZWQgdmFsdWVzIiwgeWxhYj0iUi1TdHVkZW50IHJlc2lkdWFsIikNCmBgYA0KQXMgd2UgY2FuIHNlZSB0aGVyZSBpcyBub3QgYSBjb25zaWRlcmFibGUgaW1wcm92ZW1lbnQsIG5laXRoZXIgaW4gZml4aW5nIHRoZSBsaWdodCB0YWlscy4gSW4gYWRkaXRpb24gdG8gdGhlIGxvbmcgQ0kgb2YgdGhlIEJveC1Db3gsIHdlIGNvbnNpZGVyIG5vdCBuZWNlc3NhcnkgdG8gZG8gYW55IHRyYW5zZm9ybWF0aW9uIHRvIHRoZSB5IHZhcmFpYWJsZS4NCg0KDQoNCmBgYHtyfQ0KIyMjIEhvcml6b250YWwgYmFuZCwgc28gc2F0aXNmYWN0b3J5IGRpc3RyaWJ1dGlvbg0KI3BhcihtZnJvdyA9IGMoMywgMykpDQojIFJlc2lkdWFscyB2cy4gcmVncmVzc29yIHZhcmlhYmxlcw0KcGxvdChib2R5RiRhZ2UsIGJvZHlGLm1vZGVsJHJlc2lkdWFscykNCnBsb3QoYm9keUYkd2VpZ2h0LCBib2R5Ri5tb2RlbCRyZXNpZHVhbHMpDQpwbG90KGJvZHlGJGhlaWdodCwgYm9keUYubW9kZWwkcmVzaWR1YWxzKQ0KcGxvdChib2R5RiRuZWNrLCBib2R5Ri5tb2RlbCRyZXNpZHVhbHMpDQpwbG90KGJvZHlGJGNoZXN0LCBib2R5Ri5tb2RlbCRyZXNpZHVhbHMpDQpwbG90KGJvZHlGJGFiZG9tZW4sIGJvZHlGLm1vZGVsJHJlc2lkdWFscykNCnBsb3QoYm9keUYkaGlwLCBib2R5Ri5tb2RlbCRyZXNpZHVhbHMpDQpwbG90KGJvZHlGJHRoaWdoLCBib2R5Ri5tb2RlbCRyZXNpZHVhbHMpDQpwbG90KGJvZHlGJGtuZWUsIGJvZHlGLm1vZGVsJHJlc2lkdWFscykNCnBsb3QoYm9keUYkYW5rbGUsIGJvZHlGLm1vZGVsJHJlc2lkdWFscykNCnBsb3QoYm9keUYkYmljZXBzLCBib2R5Ri5tb2RlbCRyZXNpZHVhbHMpDQpwbG90KGJvZHlGJGZvcmVhcm0sIGJvZHlGLm1vZGVsJHJlc2lkdWFscykNCnBsb3QoYm9keUYkd3Jpc3QsIGJvZHlGLm1vZGVsJHJlc2lkdWFscykNCmBgYA0KV2Ugc2VlIHRoYXQgYWxsIHRoZSBwbG90cyBoYXZlIGEgcmVjdGFuZ3VsYXIgc2hhcGUsIGluZGljYXRpbmcgdGhhdCB0aGUgdW5jb3JyZWxhdGlvbiBiZXR3ZWVuIHRoZSByZWdyZXNvcnMgYW5kIHRoZSByZXNpZHVhbHMuDQoNCmBgYHtyfQ0KIyBQYXJ0aWFsIHJlc2lkdWFsIHBsb3RzDQphdlBsb3RzKGJvZHlGLm1vZGVsKSAjIG5lZWQgdG8gcHJlc3MgZW50ZXIgaW4gdGVybWluYWwhDQpgYGANClRoZXNlIHBsb3RzLCB3aXRoIHRoZSBwcmV2aW91cyBvbmVzLCBzaG93cyB1cyB0aGF0IGl0IG1pZ2h0IG5vdCBiZSBuZWNlc2FyeSB0byB0cmFuc2Zvcm0gb3VyIHJlZ3Jlc3NvcnMgc2luY2UgYWxsIHRoZSBwbG90cyBmb2xsb3cgYSBsaW5lLg0KQWxzbyB3ZSBzZWUgdGhhdCB0aGF0IHRoZSBzbG9wZSBvZiB0aGUgaGVpZ2h0LCBjaGVzdCBhbmQga25lZSBpcyB6ZXJvLCB3aGlsZSB3ZWlnaHQsIG5lY2ssIGFiZG9tZW4sIGhpcCwgZm9yZWFybSAoZHVlIHRvIG91dGxpZXJzKSBhbmQgd3Jpc3QgaGF2ZSBncmVhdGVyIHNsb3BlLiBUaHVzLCB0aGlzIGluZGljYXRlcyB0aGF0IHdlIHNob3VsZCBwcmlvcml6ZSB0aGUgdmFyaWFibGVzIHdpdGggaGlnaGVyIHNsb3BlLg0KDQoNCmBgYHtyfQ0KIyBQUkVTUyBzdGF0aXN0aWNzDQoNCnByIDwtIHJlc2lkKGJvZHlGLm1vZGVsKS8oMSAtIGxtLmluZmx1ZW5jZShib2R5Ri5tb2RlbCkkaGF0KQ0KUFJFU1MgPC0gc3VtKHByXjIpIA0KU1N0IDwtIHN1bSgoYm9keUYkZGVuc2l0eSAtIG1lYW4oYm9keUYkZGVuc2l0eSkpXjIpDQpSMnByZWRpY3Rpb24gPC0gMSAtIFBSRVNTL1NTdA0KcHJpbnQoUjJwcmVkaWN0aW9uKQ0KYGBgDQpXZSBjb3VsZCBleHBlY3QgdGhpcyBtb2RlbCB0byBleHBsYWluIGFib3V0IDcwLjUyJSBvZiB0aGUgdmFyaWFiaWxpdHkgaW4gcHJlZGljdGluZyBuZXcgb2JzZXJ2YXRpb25zLiBXaGljaCBpcyBub3QgYXMgZGVzaXJhYmxlLCBidXQgaXQgaXMgbm90IHRoYXQgbXVjaCBvZiBhIHRyYWRlIG9mZiBjb21wYXJlZCB0byB0aGUgUjIgMC43NDUxLg0KDQoNCg0KIyMgTGV2ZXJhZ2UgYW5kIG91dGxpZXJzDQoNCg0KYGBge3J9DQojIERlZmluZSBjdXRvZmYNCmxldmVyYWdlLmN1dG9mZiA8LSAyICogcCAvIG4gICMgTVBWIHAuIDIxMw0KY29va3MuY3V0b2ZmIDwtIHFmKDAuNSwgcCwgbiAtIHAsIGxvd2VyLnRhaWwgPSBGQUxTRSkgICMgTVBWIHAuIDIxNQ0KZGZiZXRhcy5jdXRvZmYgPC0gMiAvIHNxcnQobikgICMgTVBWIHAuIDIxOA0KZGZmaXRzLmN1dG9mZiA8LSAyICogc3FydChwIC8gbikgICMgTVBWIHAuIDIxOQ0Kc3R1ZHJlcy5jdXRvZmYgPC0gcXQoMC4wNSAvIDIsIG4gLSBwLCBsb3dlci50YWlsID0gRkFMU0UpICAjIE1QViBwLiAxMzUNCmBgYA0KDQpgYGB7cn0NCiMjIyBsZXZlcmFnZSBwb2ludHMNCmJvZHlGLmhhdCA8LSBoYXR2YWx1ZXMoYm9keUYubW9kZWwpDQphIDwtYm9keUYuaGF0W2JvZHlGLmhhdCA+IGxldmVyYWdlLmN1dG9mZl0NCnByaW50KGEpDQpWaWV3KGJvZHlGW25hbWVzKGEpLF0pDQpgYGANCg0KDQoNCmBgYHtyfQ0KcGxvdChib2R5Ri5tb2RlbCwgd2hpY2g9NSkNCmBgYA0KV2UgY2FuIHNlZSB0aGF0IG5vbmUgb2YgdGhlIHBvaW50cyBhcmUgY29uc2lkZXJlZCBhcyBpbmZsdWVudGlhbHMgYmFzZWQgb24gdGhlIENvb2tzIGRpc3RhbmNlIGN1dG9mZi4gSG93ZXZlciwgd2UgaGF2ZSB0aGUgcG9pbnRzIDM5IGFuZCA4MyB3aGljaCBhcmUgaGlnaCBsZXZlcmFnZSBwb2ludHMgYW5kIGFyZSB0aGUgY2xvc2VzdCB0byBiZWluZyBpbmZsdWVudGlhbC4NCkFuYWxpemluZyB0aGUgZGF0YSB3ZSBvYnNlcnZlIHRoYXQgdGhlIHBvaW50IDM5IGNvcnJlc3BvbnRzIHRvIHRoZSBoZWF2aWVzdCBpbmRpdmlkdWFsIChoYXZpbmcgYSAxMDAgcG91bmQgZ2FwKSwgc28gdGhhdCB0cmFuc2xhdGVzIHRvIGhhdmluZyBoaWdoIGxldmVyYWdlLiBNb3Jlb3ZlciwgYXMgd2Ugc2F3IGluIHRoZSBzdHVuZGVudGl6ZWQgdnMgZml0dGVkIHBsb3QgaXQgaGFkIG9uZSBvZiB0aGUgaGlnaGVzdCByZXNpZHVhbCAobm8gc28gZ29vZCBvZiBhIGZpdCksIHNvIHRoYXQgbWFkZSBoaWdoIG1vcmUgaW5mbHVlbnRpYWwgdGhhbiB0aGUgcmVzdC4NCg0KDQoNCmBgYHtyfQ0KcGxvdChib2R5Ri5tb2RlbCwgd2hpY2g9NCkNCmBgYA0KVGhpcyBwbG90IGNvbmZpcm1zIG91ciBmaW5kaW5ncyBvZiBub3QgaGF2aW5nIGEgaW5mbHVlbnRpYWwgcG9pbnQgYmFzZWQgb24gQ29va3MgZGlzdGFuY2UsIGhvd2V2ZXIgd2Ugc2VlIHRoYXQgdGhlIHBvaW50IDM5IGhhcyBhIG11Y2ggaGlnaCB2YWx1ZSBjb21wYXJlZCB0byB0aGUgcmVzdC4NCg0KDQpgYGB7cn0NCiMgREZGSVRTDQpib2R5Ri5tb2RlbC5leHRyYSA8LSBkYXRhLmZyYW1lKGZpdHRlZC52YWx1ZXM9IGJvZHlGLm1vZGVsJGZpdHRlZC52YWx1ZXMsIGRmZml0cz0gZGZmaXRzKGJvZHlGLm1vZGVsKSkNCg0KYm9keUYubW9kZWwuZXh0cmFbYWJzKGJvZHlGLm1vZGVsLmV4dHJhWywiZGZmaXRzIl0pID4gZGZmaXRzLmN1dG9mZixdIA0KDQpwcCA8LSBnZ3Bsb3QoYm9keUYubW9kZWwuZXh0cmEsIGFlcyh4PWZpdHRlZC52YWx1ZXMsIHk9ZGZmaXRzKSkgKyANCiAgZ2VvbV9wb2ludCgpICsgIGdlb21fbGluZShkYXRhPWJvZHlGLm1vZGVsLmV4dHJhLCBhZXMoeD1maXR0ZWQudmFsdWVzLCB5PWRmZml0cy5jdXRvZmYpLCBjb2w9InJlZCIsIGxpbmV0eXBlID0gImRhc2hlZCIpICtnZW9tX2xpbmUoZGF0YT1ib2R5Ri5tb2RlbC5leHRyYSwgYWVzKHg9Zml0dGVkLnZhbHVlcywgeT0tZGZmaXRzLmN1dG9mZiksIGNvbD0icmVkIiwgbGluZXR5cGUgPSAiZGFzaGVkIikNCmdncGxvdGx5KHBwLCB0b29sdGlwPSJ0ZXh0IikNCmBgYA0KV2hlbiB3ZSBhbmFseXplIHRoZSBkZmZpdHMgd2Ugb2JzZXJ2ZSB0aGF0IHRoZXJlIGFyZSBtdWx0aXBsZSBwb2ludHN0aGF0IHBhc3Mgb3VyIHRocmVzaG9sZCwgd2hpY2ggY291bGQgaW1wbHkgdGhhdCB3ZSBzaG91bGQgY2hhbmdlIHRoZSBzdGFuZGFyZCB0aHJlc2hvbGQgdG8gYSBtb3JlIGNvbnZlbmllbnQgb25lIGZvciBvdXIgcG9ycHVzZS4gTmV2ZXJ0aGVsZXNzLCB0aGUgb25seSBwb2ludHMgdGhhdCBhcmUgY29uc2lkZXJhYmx5IG92ZXIgdGhlIHRocmVzaG9sZCBhcmUgMzkgYW5kIDgzLCB3aGljaCB3ZSBhbHJlYWR5IG9ic2VydmVkIHRoZWlyIGluZmx1ZW5jZSBieSB0aGUgQ29va3MgZGlzdGFuY2UuDQoNCk5vdyB0aGF0IHdlIGtub3cgdGhlIGluZmx1ZW5jZSBpbiB0aGUgZml0IG9mIHRoZSBwb2ludHMgMzkgYW5kIDgzIHdlIG5lZWQgdG8gYW5hbHlzZSB0aGUgcG9pbnRzIGFuZCBjb25zaWRlciBpZiB0aGV5IGFyZSB0cnVsbHkgYW4gb3V0bGllciBvciB3ZSBjYW4gY29tcGFyZSB0aGUgbW9kZWxzIGdlbmVyYXRlZCB3aXRob3V0IHRoZW0gYW5kIGNvbnNpZGVyIG1hbnRhaW5pbmcgdGhlbS4NCg0KDQpgYGB7cn0NCmJvZHlGLm1vZGVsLm91dDEgPC0gbG0oZGVuc2l0eSB+IC4sIGRhdGEgPSBib2R5RlstMzksXSkNCmJvZHlGLm1vZGVsLm91dDIgPC0gbG0oZGVuc2l0eSB+IC4sIGRhdGEgPSBib2R5RlstODMsXSkNCmJvZHlGLm1vZGVsLm91dDMgPC0gbG0oZGVuc2l0eSB+IC4sIGRhdGEgPSBib2R5RltjKC0zOSAtODMpLF0pDQpwcmludCgiQWxsIHBvaW50cyIpDQpzdW1tYXJ5KGJvZHlGLm1vZGVsKVsiYWRqLnIuc3F1YXJlZCJdDQpwcmludCgiV2l0aG91dCAzOSIpDQpzdW1tYXJ5KGJvZHlGLm1vZGVsLm91dDEpWyJhZGouci5zcXVhcmVkIl0NCnByaW50KCJXaXRob3V0IDgzIikNCnN1bW1hcnkoYm9keUYubW9kZWwub3V0MilbImFkai5yLnNxdWFyZWQiXQ0KcHJpbnQoIldpdGhvdXQgMzkgYW5kIDgzIikNCnN1bW1hcnkoYm9keUYubW9kZWwub3V0MylbImFkai5yLnNxdWFyZWQiXQ0KYGBgDQpXZSBzZWUgdGhhdCB0aGVyZSBpcyBubyBtdWNoIGRpZmVyZW5jZSBpbiB0aGUgYWRqdXN0ZWQgUjIgd2hlbiB3ZSByZW1vdmUgdGhlIGluZmx1ZW50aWFsIHBvaW50cy4gVGhlcmVmb3JlLCB3ZSBjb25jbHVkZSB0aGF0IHdlIGFyZSBnb2luZyB0byBtYWludGFpbi4gSW4gYWRkaXRpb24sIHdlIHdhbnQgdG8gbWVudGlvbiB0aGF0IHRoZWlyIHZhbHVlcyBzZWVtIGxpa2UgcG9zc2libGUgYm9keSBwcm9wb3J0aW9ucywgc28gd2UgbWlnaHQgaGF2ZSBzb21lIGFkZGVkIGludGVyZXN0IGluIG1hbnRhaW5pbmcgdGhlbS4NCg0KIyBNdWx0aWNvbGxpbmlhcml0eQ0KDQpTaW5jZSBtb3N0IG9mIG91ciByZWdyZXNzb3JzIGNvcnJlbnNwb25kIHRvIGRpbWVuc2lvbiBvZiB0aGUgYm9keSwgdGhlbiB3ZSBhbHJlYWR5IGV4cGVjdCB0byBoYXZlIHNvbWUgY29ycmVsYXRpb24gYmV0d2VlbiB0aGVtLiBBbHNvIHdlIGV4cGVjdCB0aGF0IHRoZSB3ZWlnaHQgd2lsbCBiZSBjb3JyZWxhdGVkIHRvIHNvbWUgcmVncmVzc29ycyBhcyB3ZWxsLg0KDQoNCmBgYHtyfQ0KIyBDb3JyZWxhdGlvbiBtYXRyaXggDQpnZ3BhaXJzKGRhdGEgPSBib2R5RlssLTFdKSAjIGJldHRlciBpbiB0ZXJtaW5hbA0KYGBgDQoNCldlIGNhbiBzZWUgdGhhdCB0aGUgbW9zdCB1bmNvcnJlbGF0ZWQgdmFyaWFibGUgaXMgdGhlIGFnZSwgYW5kIHRoZW4gdGhlIGhlaWdodC4gSG93ZXZlciB3ZSBoYXZlIGhpZ2ggY29ycmVsYXRpb25zIGJldHdlZW4gdGhlIHJlc3QgYm9keSBkaW1lbnNpb25zIGFzIHdlIGV4cGVjdGVkLg0KDQpgYGB7cn0NCiMgVmFyaWFuY2UgaW5mbGF0aW9uIGZhY3RvciAoVklGKQ0KIyBIYXJkIEN1dG9mZiBpcyAxMCwgc29mdCBjdXR0b2YgaXMgNQ0KdmlmKGJvZHlGLm1vZGVsKSANCmBgYA0KV2Ugc2VlIHRoYXQgd2VpZ2h0LCBjaGVzdCAobWVyZWx5KSwgYWJkb21lbiBhbmQgaGlwIHN1cnBhc3MgdGhlIGN1dG9mZiBvZiAxMCBpbiB0aGUgVklGLCB3aGljaCBpbmRpY2F0ZSB1cyB0aGF0IHRoZXNlIHZhcmlhYmxlcyBoYXZlIGEgZ3JlYXQgZGVwZW5kYW5jZSB3aXRoIHRoZSByZXN0LiBXZSB3aWxsIGl0ZXJhdGl2ZWxseSByZW1vdmUgdGhpcyB2YXJpYWJsZXMgYW5kIHJlY2FsY3VsYXRlIHRoZSBWSUZzIHVudGlsbCB0aGVyZSBpcyBubyBtb3JlIHZhcmlhYmxlcyB3aXRoIHZhbHVlIGdyZWF0ZXIgdGhhbiAxMC4NCg0KYGBge3J9DQpib2R5Ri5ub1dlaWdodCA8LSBib2R5RlssLTNdDQpib2R5Ri5tb2RlbC5yZWQxIDwtIGxtKGRlbnNpdHkgfiAuLCBkYXRhID0gYm9keUYubm9XZWlnaHQpDQp2aWYoYm9keUYubW9kZWwucmVkMSkgDQpgYGANCldlIG9ic2VydmUgdGhhdCB3ZSBoYXZlIHJlZHVjZWQgY29uc2lkZXJhYmx5IHRoZSBtdWx0aWNvbGxpbmlhcml0eS4gTm93IHdlIGFyZSBnb2luZyB0byByZW1vdmUgYWJkb21lbi4NCg0KYGBge3J9DQpib2R5Ri5ub1dlaWdodF9ub0FicyA8LSBib2R5RlssYygtMywgLTcpXQ0KYm9keUYubW9kZWwucmVkMSA8LSBsbShkZW5zaXR5IH4gLiwgZGF0YSA9IGJvZHlGLm5vV2VpZ2h0X25vQWJzKQ0KdmlmKGJvZHlGLm1vZGVsLnJlZDEpIA0KYGBgDQpXZSBzdGlsbCBoYXZlIHNvbWUgbXVsdGljb2xsaW5pYXJpdHkgc3VjaCBhcyBjaGVzdCwgaGlwIGFuZCB0aGlnaHQsIGJ1dCBub3QgYXMgc2V2ZXJlIGFzIGJlZm9yZS4gVGhlcmVmb3JlIHdlIGNhbiBwcm9jZWRlIHRvIHZhcmlhYmxlIHNlbGVjdGlvbiB3aXRoIHRoaXMgcmVkdWNlZCBkYXRhLg0KDQojIFZhcmFpYWJsZSBzZWxlY3Rpb24NCiMjIEFsbCByZWdyZXNvcnMNCmBgYHtyfQ0KYm9keUYubW9kZWwucmVkMiA8LSByZWdzdWJzZXRzKGRlbnNpdHl+LiwgZGF0YSA9IGJvZHlGLm5vV2VpZ2h0X25vQWJzLCBudm1heCA9IDExKQ0KYGBgDQoNCmBgYHtyfQ0KYTwtc3VtbWFyeShib2R5Ri5tb2RlbC5yZWQyKQ0Kc3VtbWFyeShib2R5Ri5tb2RlbC5yZWQyKQ0KcHJpbnQoIkJlc3QgQWRqdXN0ZWQgUjIiKQ0Kd2hpY2gubWF4KHN1bW1hcnkoYm9keUYubW9kZWwucmVkMikkYWRqcjIpDQpwcmludCgiQmVzdCBDcCIpDQp3aGljaC5taW4oc3VtbWFyeShib2R5Ri5tb2RlbC5yZWQyKSRjcCkNCnByaW50KCJCZXN0IEJJQyIpDQp3aGljaC5taW4oc3VtbWFyeShib2R5Ri5tb2RlbC5yZWQyKSRiaWMpDQpgYGANCmBgYHtyfQ0KYWxsX3Bvc3NpYmxlX3JlcyA8LSBvbHNfc3RlcF9hbGxfcG9zc2libGUoYm9keUYubW9kZWwucmVkMSwgbWV0cmljID0gYygicnNxdWFyZSIsICJhZGpyIiwgImNwIiwgImFpYyIsICJzYmljIiwgIm1zZXAiKSkNCnBsb3QoYWxsX3Bvc3NpYmxlX3JlcykNCmBgYA0KYGBge3J9DQpWaWV3KGFsbF9wb3NzaWJsZV9yZXNbMTgxNixdKQ0KYGBgDQoNCg0KIyMgRm9yd2FyZA0KIyMgQmFja2dhcmQNCiMjIEJlc3QgYmFzZWQgb24gQ3Jvc3MgdmFsaWRhdGlvbg0KDQojIEJvb3RzdHJhcCBhc3Nlc21lbnQgb2YgdGhlIG1vZGVsDQoNCg0KDQoNCg0KDQo=